home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
UTIL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
8KB
|
296 lines
UNIT Util;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Utility procedures and functions Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos, OpDate, OpEntry, PoPTypes{,FuncSrvr};
{$IFNDEF OS2}
CONST
BiosTics : ^LongInt = NIL;
{$ENDIF}
PROCEDURE FreeUpMemory;
FUNCTION Max64k(Size: LongInt): Word;
FUNCTION Min(a, b: LongInt): LongInt;
PROCEDURE Pause(t: Word);
FUNCTION GotESC : Boolean;
PROCEDURE AddToCallList(Dir: Byte; CONST Adr: TFidoAddress; CONST s: S35);
PROCEDURE FinishPortal;
PROCEDURE SpawnWithErrorlevel(l: Integer; CONST s: String; MakeBusy: Boolean);
PROCEDURE ErrorHandler;
PROCEDURE AskError(YPos: Byte; CONST Txt: S80; ColorLevel: Byte);
PROCEDURE UserInformation(YPos: Byte; CONST Txt: S80; ColorLevel: Byte; Hlp:WORD);
FUNCTION AskFinish : Boolean;
PROCEDURE ConfigPostEdit(Esr: EntryScreenPtr);
FUNCTION ArcCommand(ArcNum, CmdNum: Byte; CONST Arc, Spec: PathStr): Boolean;
FUNCTION TimeIsBetween(Time1, Time2: Time): Boolean;
{$IFNDEF OS2}
PROCEDURE FindClose(VAR Sr: SearchRec);
{$ENDIF}
IMPLEMENTATION
USES OpCrt, OpWindow, OpEdit, OpString, OpPick, OpHelp, OpDos, OpKey,
ApTimer, Dpmi,
{$IFNDEF PMode}
OpMacro,
{$ENDIF}
{$IFDEF StackCheck}
OpStack,
{$ENDIF}
FileUtil, OproUtil, StrUtil, Keyboard, LogFile, ScrBlank, Display,
NodeList, DosShell, MTask, Globals, MailUtil, Com, Modem;
PROCEDURE FreeUpMemory;
BEGIN
DeAllocateNodelistIndex;
DisposeNodesIdx;
IF MainMenu<>NIL THEN
BEGIN
Dispose(MainMenu, Done);
MainMenu:=NIL;
END;
END;
FUNCTION Max64k(Size: LongInt): Word;
BEGIN
IF Size>65520 THEN Max64k:=65520 ELSE Max64k:=Size;
END;
FUNCTION Min(a, b: LongInt): LongInt;
BEGIN
IF a<b THEN Min:=a ELSE Min:=b;
END;
FUNCTION TimeIsBetween(Time1, Time2: Time): Boolean;
BEGIN
IF Time1=Time2 THEN
TimeIsBetween:=True
ELSE
IF Time2>=Time1 THEN
BEGIN
TimeIsBetween:=(CurrentTime>=Time1) And (CurrentTime<=Time2);
END ELSE
BEGIN
TimeIsBetween:=Not ((CurrentTime>=Time2) And (CurrentTime<=Time1));
END;
END;
PROCEDURE Pause(t: Word);
VAR
tt: EventTimer;
BEGIN
NewTimer(tt, Secs2Tics(t) DIV 100);
WHILE Not TimerExpired(tt) DO
GiveUpTime;
END;
FUNCTION ArcCommand(arcnum,cmdnum:BYTE; CONST arc,spec:PathStr):BOOLEAN;
VAR
prg,prg2,s:STRING;
Temp:WindowPtr;
i : Integer;
BEGIN
ArcCommand:=False;
ArcNum:=Abs(ArcNum);
IF ArcNum=0 THEN ArcNum:=3;
IF ArcNum IN [1..7] THEN
BEGIN
CASE cmdnum OF
1 : s:=Cfg.Packer[arcnum].AddCmd;
2 : s:=Cfg.Packer[arcnum].UnPackCmd;
3 : s:=Cfg.Packer[arcnum].EraseCmd;
4 : s:=Cfg.Packer[arcnum].TestCmd;
END;
IF s<>'' THEN
BEGIN
prg:=COPY(s,1,POS(' ',s)-1);
prg2:=FExpand(FSearch(prg,'.;'+GetEnv('PATH')));
Delete(s,1,Length(prg)+1);
Replace(s,'$archive',arc,0);
Replace(s,'$filespec',spec,0);
MyWin(Temp,1,1,80,ScreenHeight,0,'',False);
WriteLn('Executing: '+JustFileName(Prg2)+' '+s);
i:=ShellToDos(prg2,s,False);
IF i<>0 THEN AddLog('!','Error '+Long2Str(i)+' running: "'+JustFileName(Prg2)+' '+s+'"');
KillWindow(Temp);
ArcCommand:=(i=0) AND (DosExitCode=0);
END;
END;
END;
PROCEDURE ConfigPostEdit(Esr: EntryScreenPtr);
BEGIN
IF ESR^.CurrentFieldModified THEN ConfigChanged:=True;
END;
FUNCTION GotESC : Boolean;
BEGIN
GotESC:=PoPKeyPressed AND (PoPReadKeyWord=Esc);
END;
PROCEDURE AddToCallList(Dir: Byte; CONST Adr: TFidoAddress; CONST s: S35);
VAR
i : Byte;
BEGIN
i:=0;
REPEAT
Inc(i);
UNTIL (i = 5) OR (Data.Calls[Dir,i].Adr.Zone=0);
IF (Data.Calls[Dir,5].Adr.Zone<>0) THEN Move(data.Calls[Dir,2], data.Calls[Dir,1], 4 * 29);
WITH Data.Calls[Dir,i].Adr DO
BEGIN
Zone:=Adr.Zone;
Net:=Adr.Net;
Node:=Adr.Node;
Point:=Adr.Point;
END;
Data.Calls[Dir,i].Name:=s;
Data.Calls[Dir,i].T:=CurrentTime;
IF ScreenHeight>LinesForStat THEN
IF Dir=1 THEN UpdateCallsWindow(CallsIn,1) ELSE UpdateCallsWindow(CallsOut,2);
END;
FUNCTION AskFinish : Boolean;
VAR
TempWin : windowptr;
x : Byte;
c : Char;
InKey : Word;
BEGIN
mywin(TempWin, 15, 9, 66, 12, 2, 'Leaving PORTAL ??',True);
WITH TempWin^ DO
BEGIN
wFastText('Resuming operation in second(s)',1,2);
wFastText('Hit ESC again to finish portal, Enter to resume.',2,2);
END;
WHILE PopKeyPressed DO
InKey:=PopReadKeyWord;
x:=49; InKey:=0;
REPEAT
c:=CHAR(48+(x DIV 10 + 1));
TempWin^.wFastText(c,1,24);
Dec(x);
Pause(10);
IF PoPKeyPressed THEN InKey:=PopReadKeyWord;
UNTIL (x <= 0) OR (Lo(InKey)=13) OR (InKey=Esc) Or (InKey=AltX);
AskFinish:=(InKey=Esc) or (InKey=AltX);
KillWindow(TempWin);
END;
PROCEDURE AskError(ypos:BYTE; CONST Txt:S80; colorlevel:BYTE);
VAR
Temp:WindowPtr;
x:BYTE;
BEGIN
x:=(65-Length(Txt)) DIV 2;
mywin(Temp,x,ypos,x+16+Length(Txt),ypos+2,ColorLevel,'Error',True);
FASTWRITE(txt+' - Hit RETURN',ypos+1,x+2,cfg.color[3].TextColor);
REPEAT
UNTIL PopReadKeyWord=Enter;
KillWindow(Temp);
END;
PROCEDURE UserInformation(YPos: Byte; CONST Txt: S80; ColorLevel: Byte; Hlp:WORD);
VAR
Temp:WindowPtr;
x:BYTE;
OldHelp:WORD;
BEGIN
OldHelp:=Topic;
Topic:=Hlp;
x:=(65-Length(Txt)) DIV 2;
mywin(Temp,x,ypos,x+16+Length(Txt),ypos+2,ColorLevel,'Information',True);
Temp^.wFASTWRITE(txt+' - Hit RETURN',1,2,cfg.color[3].TextColor);
REPEAT
UNTIL PopReadKeyWord=Enter;
KillWindow(Temp);
Topic:=OldHelp;
END;
PROCEDURE FinishPortal;
VAR
f : FILE OF TDataFile;
f1: FILE OF TPortalStat;
BEGIN
DeAllocateNodeListIndex;
DisposeNodesIdx;
Assign(f, AddBackSlash(StartPath)+MakeTaskFileName(PoPDataFileName));
Rewrite(f);
Write(f, data);
Close(f);
Assign(f1, AddBackSlash(StartPath)+MakeTaskFileName(PoPStatisticsFileName));
Rewrite(f1);
Write(f1, StatRec^);
Close(f1);
Dispose(StatRec);
{ FinishFunctionServer;}
END;
PROCEDURE ErrorHandler;
BEGIN
ExitProc:=OldErrPtr;
TurnScreen(On);
{$IFNDEF OS2}
SetCBreak(SaveBreakState);
{$ENDIF}
IF NOT Cfg.Screen.KeepOffScrMode AND (ScreenHeight>25) THEN
BEGIN
ScrollWindowUp(1, 1, 80, ScreenHeight, ScreenHeight-25);
SelectFont8x8(False);
END;
NormalCursor;
IF ErrorAddr<>Nil THEN
BEGIN
ComPort^.SetDtr(Off);
AddLog('!','FunTime Error '+Long2Str(ExitCode)+' at: '+HexPtr(ErrorAddr)+' - Get DRUNK!');
ErrorAddr:=Nil; ExitCode:=0;
{$IFDEF StackCheck}
LogStackUsage;
{$ENDIF}
END;
CloseFiles(True);
TextAttr:=$07;
GotoXYAbs(1, ScreenHeight);
END;
PROCEDURE SpawnWithErrorlevel(l: Integer; CONST s: String; MakeBusy: Boolean);
VAR
Elevel : String[3];
BEGIN
IF MakeBusy THEN MakeModemBusy;
Str(l, Elevel);
AddLog(':', s + ' with errorlevel ' + Elevel);
{$IFDEF StackCheck}
LogStackUsage;
{$ENDIF}
AddLog('+', 'End, Portal of Power v' + Ver);
FinishPortal;
Halt(l);
END;
{$IFNDEF OS2}
PROCEDURE FindClose(VAR Sr: SearchRec);
BEGIN
END;
{$ENDIF}
{$IFNDEF OS2}
BEGIN
BiosTics := Ptr(BiosDataSele, $6C);
{$ENDIF}
END.